home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / BTV115.ARJ / RECOVER.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-04  |  5KB  |  218 lines
  1. PROGRAM RECOVER;
  2. {$V-,S-,R-,A-,I-,X-}
  3.  
  4.  
  5.  
  6. USES
  7.   CRT,
  8.   DOS,
  9.   BTV;
  10.  
  11.  
  12. TYPE
  13.   { declare an error display type }
  14.   ErrorType = Object(ErrorDisplay)
  15.     Function    Display(Error     : Integer;
  16.                         ErrorMsg  : String;
  17.                         OpCode    : Byte;
  18.                         OpCodeMsg : String;
  19.                         FileName  : PathStr
  20.                         ): ErrorAction;             Virtual;
  21.   end;
  22.  
  23.   { declare a progress display type }
  24.   TNewProgress  = Object(TProgress)
  25.     X,Y : Byte;
  26.  
  27.     Constructor Init;
  28.     Procedure   Display(Count : LongInt);           Virtual;
  29.   end;
  30.  
  31.  
  32. VAR
  33.   ErrDisplay  : ErrorType;
  34.   ErrHandler  : ErrorHandler;
  35.   BFile       : BtrieveFile;
  36.   i,j         : Integer;
  37.   Name1       : PathStr;
  38.   Name2       : PathStr;
  39.   Param       : PathStr;
  40.   Buff        : Pointer;
  41.   Switch      : Char;
  42.   Display     : TNewProgress;
  43.  
  44.  
  45.  
  46.  
  47. Procedure DosWriteln(S : String);
  48.  
  49.   var
  50.     Regs  : Registers;
  51.     Temp  : Array[0..80] of Char;
  52.     SLen  : Byte Absolute S;
  53.  
  54.   begin
  55.     Move(S[1], Temp[0], SLen);
  56.     Temp[SLen]   := #13;
  57.     Temp[SLen+1] := #10;
  58.     Temp[SLen+2] := '$';
  59.     Regs.DS := Seg(Temp);
  60.     Regs.DX := Ofs(Temp);
  61.     Regs.AH := $09;
  62.     { call DOS int 21h function 09h to print the string because unlike
  63.       Turbo's Writeln this output will get redirected
  64.     }
  65.     MsDos(Regs);
  66.   end;
  67.  
  68. Procedure DosWrite(S : String);
  69.  
  70.   var
  71.     Regs  : Registers;
  72.     Temp  : Array[0..80] of Char;
  73.     SLen  : Byte Absolute S;
  74.  
  75.   begin
  76.     Move(S[1], Temp[0], SLen);
  77.     Temp[SLen] := '$';
  78.     Regs.DS := Seg(Temp);
  79.     Regs.DX := Ofs(Temp);
  80.     Regs.AH := $09;
  81.     { call DOS int 21h function 09h to print the string because unlike
  82.       Turbo's Writeln this output will get redirected
  83.     }
  84.     MsDos(Regs);
  85.   end;
  86.  
  87.  
  88. Function ErrorType.Display(Error     : Integer;
  89.                            ErrorMsg  : String;
  90.                            OpCode    : Byte;
  91.                            OpCodeMsg : String;
  92.                            FileName  : PathStr
  93.                            ): ErrorAction;
  94.  
  95.   var
  96.     St : String[5];
  97.  
  98.   begin
  99.     DosWriteln(FileName);
  100.     Str(Error, St);
  101.     DosWriteln(ErrorMsg  + '# ' + St);
  102.     Str(OpCode, St);
  103.     DosWriteln(OpCodeMsg + '# ' + St);
  104.     Display := erAbort;
  105.   end;
  106.  
  107.  
  108. Constructor TNewProgress.Init;
  109.   begin
  110.     TProgress.Init;
  111.     X := WhereX;
  112.     Y := WhereY;
  113.   end;
  114.  
  115. Procedure TNewProgress.Display(Count : LongInt);
  116.  
  117.   var
  118.     S : String[12];
  119.  
  120.   begin
  121.     GotoXY(X,Y);
  122.     Str(Count, S);
  123.     DosWrite('Records so far ' + S);
  124.   end;
  125.  
  126.  
  127. BEGIN
  128.   { init command line params  }
  129.   Name1 := '';
  130.   Name2 := '';
  131.   Switch := ' ';
  132.  
  133.   { load command line params  }
  134.   for i := 1 to ParamCount do
  135.   begin
  136.     Param := ParamStr(i);
  137.  
  138.     if (Param[1] = '-') or (Param[1] = '/') then
  139.       Delete(Param, 1,1);
  140.  
  141.     for j := 1 to Length(Param) do
  142.       Param[j] := UpCase(Param[j]);
  143.  
  144.     if (Param = 'R') then
  145.       Switch := 'R'
  146.     else if (Param = 'S') then
  147.       Switch := 'S'
  148.     else if (Param = 'L') then
  149.       Switch := 'L'
  150.     else if (Name1 = '') then
  151.       Name1 := Param
  152.     else if (Name2 = '') then
  153.       Name2 := Param;
  154.   end;
  155.  
  156.   { all params not specified  }
  157.   if (ParamCount <> 3) or (Switch = ' ') or (Name1 = '') or (Name2 = '') then
  158.   begin
  159.     DosWriteln('Recover, Save or Load a Btrieve file');
  160.     DosWriteln('Usage : Recover -R <Btrieve Input File> <Btrieve Output file>');
  161.     DosWriteln('        Recover -S <Btrieve Input File> <DOS Output file>');
  162.     DosWriteln('        Recover -L <DOS Input File> <Btrieve Output file>');
  163.     Halt;
  164.   end;
  165.  
  166.   { make sure Btrieve is loaded }
  167.   CheckForBtrieve;
  168.  
  169.   { allocate file data buffer }
  170.   GetMem(Buff, $FFF0);
  171.  
  172.   if (Buff = nil) then
  173.   begin
  174.     DosWriteln('Not enough memory!');
  175.     Halt;
  176.   end;
  177.  
  178.   { first make a error display }
  179.   ErrDisplay.Init;
  180.   { make an error handler, it needs a display object  }
  181.   ErrHandler.Init(@ErrDisplay);
  182.  
  183.   { init progress display }
  184.   Display.Init;
  185.   DosWriteln('');
  186.  
  187.   { execute selected option }
  188.   Case Switch of
  189.     'R' :
  190.       begin
  191.         BFile.Init(Name1, @ErrHandler, Buff, $FFF0);
  192.         BFile.Open(bReadOnly, '');
  193.         i := BFile.Recover(Name2, @Display);
  194.       end;
  195.  
  196.     'S' :
  197.       begin
  198.         BFile.Init(Name1, @ErrHandler, Buff, $FFF0);
  199.         BFile.Open(bReadOnly, '');
  200.         i := BFile.Save(Name2, @Display);
  201.       end;
  202.  
  203.     'L' :
  204.       begin
  205.         BFile.Init(Name2, @ErrHandler, Buff, $FFF0);
  206.         BFile.Open(bAccelerated, '');
  207.         i := BFile.Load(Name1, @Display);
  208.       end;
  209.   end;
  210.  
  211.   DosWriteln('');
  212.   DosWriteln('');
  213.  
  214.   if (i <> 0) then
  215.     DosWriteln('FAILURE!')
  216.   else
  217.     DosWriteln('SUCCESS!');
  218. END.